home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / reordr.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  10KB  |  324 lines
  1. /* reordr.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  33.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  34. } flags_;
  35.  
  36. #define flags_1 flags_
  37.  
  38. struct {
  39.     doublereal value[200000];
  40. } blank_;
  41.  
  42. #define blank_1 blank_
  43.  
  44. struct {
  45.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  46.         sfactr;
  47.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  48.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  49. } status_;
  50.  
  51. #define status_1 status_
  52.  
  53. /* Table of constant values */
  54.  
  55. static integer c__1 = 1;
  56.  
  57. /*<       subroutine reordr >*/
  58. /* Subroutine */ int reordr_()
  59. {
  60.     /* Format strings */
  61.     static char fmt_591[] = "(\0020*abort*:  spice internal error in reord\
  62. r\002/)";
  63.  
  64.     /* System generated locals */
  65.     integer i_1;
  66.  
  67.     /* Builtin functions */
  68.     integer s_wsfe(), e_wsfe();
  69.  
  70.     /* Local variables */
  71.     static integer node, locx, node1, node2;
  72.     extern /* Subroutine */ int getm4_(), copy4_();
  73.     static integer i, j, l, nflag, nodex, ltemp, nextv, ix;
  74. #define nodplc ((integer *)&blank_1)
  75. #define cvalue ((complex *)&blank_1)
  76.     extern /* Subroutine */ int swapij_();
  77.     static integer loc;
  78.  
  79.     /* Fortran I/O blocks */
  80.     static cilist io__16 = { 0, 0, 0, fmt_591, 0 };
  81.  
  82.  
  83. /*<       implicit double precision (a-h,o-z) >*/
  84.  
  85. /*     this routine swaps rows in the coefficient matrix to eliminate */
  86. /* singularity problems which can be recognized by examining the circuit 
  87. */
  88. /* topology. */
  89.  
  90. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  91. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  92. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  93. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  94. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  95. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  96. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  97. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  98. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  99. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  100. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  101. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  102. /* spice version 2g.6  sccsid=flags 3/15/83 */
  103. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  104. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  105. /* spice version 2g.6  sccsid=blank 3/15/83 */
  106. /*<       common /blank/ value(200000) >*/
  107. /* spice version 2g.6  sccsid=status 3/15/83 */
  108. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  109. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  110. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  111. /*<       integer nodplc(64) >*/
  112. /*<       complex cvalue(32) >*/
  113. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  114.  
  115. /*  allocate and initialize storage */
  116.  
  117. /*<       call getm4(irswpf,nstop) >*/
  118.     getm4_(&tabinf_1.irswpf, &cirdat_1.nstop);
  119. /*<       call getm4(irswpr,nstop) >*/
  120.     getm4_(&tabinf_1.irswpr, &cirdat_1.nstop);
  121. /*<       call getm4(icswpf,nstop) >*/
  122.     getm4_(&tabinf_1.icswpf, &cirdat_1.nstop);
  123. /*<       call getm4(icswpr,nstop) >*/
  124.     getm4_(&tabinf_1.icswpr, &cirdat_1.nstop);
  125.  
  126. /*<       do 10 i=1,nstop >*/
  127.     i_1 = cirdat_1.nstop;
  128.     for (i = 1; i <= i_1; ++i) {
  129. /*<       nodplc(irswpf+i)=i >*/
  130.     nodplc[tabinf_1.irswpf + i - 1] = i;
  131. /*<    10 continue >*/
  132. /* L10: */
  133.     }
  134. /*<       call copy4(nodplc(irswpf+1),nodplc(irswpr+1),nstop) >*/
  135.     copy4_(&nodplc[tabinf_1.irswpf], &nodplc[tabinf_1.irswpr], &
  136.         cirdat_1.nstop);
  137. /*<       call copy4(nodplc(irswpf+1),nodplc(icswpf+1),nstop) >*/
  138.     copy4_(&nodplc[tabinf_1.irswpf], &nodplc[tabinf_1.icswpf], &
  139.         cirdat_1.nstop);
  140. /*<       call copy4(nodplc(irswpf+1),nodplc(icswpr+1),nstop) >*/
  141.     copy4_(&nodplc[tabinf_1.irswpf], &nodplc[tabinf_1.icswpr], &
  142.         cirdat_1.nstop);
  143.  
  144. /*  swap current equations into admittance part of equation matrix */
  145.  
  146. /*<       nextv=1 >*/
  147.     nextv = 1;
  148.  
  149. /*  find suitable voltage source */
  150.  
  151. /*<   100 if (nextv.gt.numvs) go to 600 >*/
  152. L100:
  153.     if (nextv > cirdat_1.numvs) {
  154.     goto L600;
  155.     }
  156. /*<       ix=0 >*/
  157.     ix = 0;
  158. /*<       do 130 i=nextv,numvs >*/
  159.     i_1 = cirdat_1.numvs;
  160.     for (i = nextv; i <= i_1; ++i) {
  161. /*<       loc=nodplc(iseq+i) >*/
  162.     loc = nodplc[tabinf_1.iseq + i - 1];
  163. /*<       node=nodplc(loc+2) >*/
  164.     node = nodplc[loc + 1];
  165. /*<       nflag=nodplc(iseq1+i) >*/
  166.     nflag = nodplc[tabinf_1.iseq1 + i - 1];
  167. /*<       if (nflag.eq.1) node=nodplc(loc+6) >*/
  168.     if (nflag == 1) {
  169.         node = nodplc[loc + 5];
  170.     }
  171. /*<       if (nflag.eq.2) node=nodplc(loc+7) >*/
  172.     if (nflag == 2) {
  173.         node = nodplc[loc + 6];
  174.     }
  175. /*<       if (node.eq.1) go to 110 >*/
  176.     if (node == 1) {
  177.         goto L110;
  178.     }
  179. /*<       if (nodplc(nodevs+node).ge.2) go to 110 >*/
  180.     if (nodplc[tabinf_1.nodevs + node - 1] >= 2) {
  181.         goto L110;
  182.     }
  183. /*<       if (nodplc(ndiag+node).eq.0) go to 145 >*/
  184.     if (nodplc[tabinf_1.ndiag + node - 1] == 0) {
  185.         goto L145;
  186.     }
  187. /*<       ix=i >*/
  188.     ix = i;
  189. /*<       locx=loc >*/
  190.     locx = loc;
  191. /*<       nodex=node >*/
  192.     nodex = node;
  193. /*<   110 node=nodplc(loc+3) >*/
  194. L110:
  195.     node = nodplc[loc + 2];
  196. /*<       if (nflag.eq.2) node=nodplc(loc+5) >*/
  197.     if (nflag == 2) {
  198.         node = nodplc[loc + 4];
  199.     }
  200. /*<       if (node.eq.1) go to 130 >*/
  201.     if (node == 1) {
  202.         goto L130;
  203.     }
  204. /*<       if (nodplc(nodevs+node).ge.2) go to 130 >*/
  205.     if (nodplc[tabinf_1.nodevs + node - 1] >= 2) {
  206.         goto L130;
  207.     }
  208. /*<   120 if (nodplc(ndiag+node).eq.0) go to 145 >*/
  209. /* L120: */
  210.     if (nodplc[tabinf_1.ndiag + node - 1] == 0) {
  211.         goto L145;
  212.     }
  213. /*<       ix=i >*/
  214.     ix = i;
  215. /*<       locx=loc >*/
  216.     locx = loc;
  217. /*<       nodex=node >*/
  218.     nodex = node;
  219. /*<   130 continue >*/
  220. L130:
  221.     ;}
  222. /*<       if (ix.eq.0) go to 590 >*/
  223.     if (ix == 0) {
  224.     goto L590;
  225.     }
  226. /*<       i=ix >*/
  227.     i = ix;
  228. /*<       loc=locx >*/
  229.     loc = locx;
  230. /*<       node=nodex >*/
  231.     node = nodex;
  232.  
  233. /*  resequence voltage sources */
  234.  
  235. /*<   145 nodplc(iseq+i)=nodplc(iseq+nextv) >*/
  236. L145:
  237.     nodplc[tabinf_1.iseq + i - 1] = nodplc[tabinf_1.iseq + nextv - 1];
  238. /*<       nodplc(iseq+nextv)=loc >*/
  239.     nodplc[tabinf_1.iseq + nextv - 1] = loc;
  240. /*<       ltemp=nodplc(iseq1+i) >*/
  241.     ltemp = nodplc[tabinf_1.iseq1 + i - 1];
  242. /*<       nodplc(iseq1+i)=nodplc(iseq1+nextv) >*/
  243.     nodplc[tabinf_1.iseq1 + i - 1] = nodplc[tabinf_1.iseq1 + nextv - 1];
  244. /*<       nodplc(iseq1+nextv)=ltemp >*/
  245.     nodplc[tabinf_1.iseq1 + nextv - 1] = ltemp;
  246. /*<       ibr=nodplc(neqn+i) >*/
  247.     cirdat_1.ibr = nodplc[tabinf_1.neqn + i - 1];
  248. /*<       nodplc(neqn+i)=nodplc(neqn+nextv) >*/
  249.     nodplc[tabinf_1.neqn + i - 1] = nodplc[tabinf_1.neqn + nextv - 1];
  250. /*<       nodplc(neqn+nextv)=ibr >*/
  251.     nodplc[tabinf_1.neqn + nextv - 1] = cirdat_1.ibr;
  252. /*<       node1=nodplc(loc+2) >*/
  253.     node1 = nodplc[loc + 1];
  254. /*<       if (ltemp.eq.1) node1=nodplc(loc+6) >*/
  255.     if (ltemp == 1) {
  256.     node1 = nodplc[loc + 5];
  257.     }
  258. /*<       if (ltemp.eq.2) node1=nodplc(loc+7) >*/
  259.     if (ltemp == 2) {
  260.     node1 = nodplc[loc + 6];
  261.     }
  262. /*<       node2=nodplc(loc+3) >*/
  263.     node2 = nodplc[loc + 2];
  264. /*<       if (ltemp.eq.1) node2=nodplc(loc+3) >*/
  265.     if (ltemp == 1) {
  266.     node2 = nodplc[loc + 2];
  267.     }
  268. /*<       if (ltemp.eq.2) node2=nodplc(loc+5) >*/
  269.     if (ltemp == 2) {
  270.     node2 = nodplc[loc + 4];
  271.     }
  272. /*<       nodplc(nodevs+node1)=nodplc(nodevs+node1)-1 >*/
  273.     --nodplc[tabinf_1.nodevs + node1 - 1];
  274. /*<       nodplc(nodevs+node2)=nodplc(nodevs+node2)-1 >*/
  275.     --nodplc[tabinf_1.nodevs + node2 - 1];
  276.  
  277. /*  set row swap indicators */
  278.  
  279. /*<       l=nodplc(irswpf+ibr) >*/
  280.     l = nodplc[tabinf_1.irswpf + cirdat_1.ibr - 1];
  281. /*<       j=nodplc(irswpr+node) >*/
  282.     j = nodplc[tabinf_1.irswpr + node - 1];
  283. /*<       nodplc(irswpf+j)=l >*/
  284.     nodplc[tabinf_1.irswpf + j - 1] = l;
  285. /*<       nodplc(irswpr+l)=j >*/
  286.     nodplc[tabinf_1.irswpr + l - 1] = j;
  287. /*<       nodplc(irswpf+ibr)=node >*/
  288.     nodplc[tabinf_1.irswpf + cirdat_1.ibr - 1] = node;
  289. /*<       nodplc(irswpr+node)=ibr >*/
  290.     nodplc[tabinf_1.irswpr + node - 1] = cirdat_1.ibr;
  291. /*<       call swapij(ibr,j,1,1) >*/
  292.     swapij_(&cirdat_1.ibr, &j, &c__1, &c__1);
  293. /*<       nextv=nextv+1 >*/
  294.     ++nextv;
  295. /*<       go to 100 >*/
  296.     goto L100;
  297.  
  298.  
  299. /*  error - voltage-source/inductor/transmission-line loop detected ... */
  300.  
  301.  
  302. /*<   590 nogo=1 >*/
  303. L590:
  304.     flags_1.nogo = 1;
  305. /*<       write (iofile,591) >*/
  306.     io__16.ciunit = status_1.iofile;
  307.     s_wsfe(&io__16);
  308.     e_wsfe();
  309. /* ...  loop should have been detected in topchk */
  310. /*<   591 format('0*abort*:  spice internal error in reordr'/) >*/
  311.  
  312. /*  finished */
  313.  
  314. /*<   600 return >*/
  315. L600:
  316.     return 0;
  317. /*<       end >*/
  318. } /* reordr_ */
  319.  
  320. #undef cvalue
  321. #undef nodplc
  322.  
  323.  
  324.